(library (lib web-location-handling)
  (export
   static-assets-dir-name
   static-assets-dir-location
   safe-location?
   static-asset-location?
   safe/static-asset-location?
   static-asset-location)
  (import
    (except (rnrs base) let-values)
    (only (guile)
          lambda* λ
          canonicalize-path)
    (prefix (srfi srfi-1) srfi-1:)
    (prefix (lib logging) log:)
    (prefix (fslib) fslib:)))


;; ======================
;; YET TO IMPLEMENT PARTS
;; ======================

;; location-inside? should be a procedure from guile-fslib instead.
(define location-inside?
  (λ (loc maybe-ancestor)
    (log:debug "checking whether" loc "is inside" maybe-ancestor)
    (fslib:sub-fsing? loc maybe-ancestor)))

;; complex-location? should be a procedure from guile-fslib instead.
(define complex-location?
  (λ (loc)
    (log:warning "not yet implemented: complex-location?")
    #f))


;; ==========================
;; DEFINITIONS OF THIS MODULE
;; ==========================

;; Define some bindings, which are required for security reasons.

(define static-assets-dir-name "static")
(define static-assets-dir-location
  ;; Get the absolute path, without any ".", "..", repeated
  ;; "/" or symlinks in it.
  (canonicalize-path static-assets-dir-name))


(define safe-location?
  (λ (location maybe-ancestor-location)
    "Check, whether a location is deemed safe to serve files
from. A location is deemed safe, if it is a descendant of
the static assets directory."
    (log:debug "checking for safety of path")
    (let ([canonicalized-location (canonicalize-path location)])
      (location-inside? canonicalized-location
                        static-assets-dir-location))))


(define static-asset-location?
  (λ (location)
    "Check if the path's first part is the static directory. Warning: This
predicate does not guarantee it to be a safe location, because there could be
special parts in that location, such as dots or tilde."
    (log:debug "checking whether location" location "is static asset location")
    (let ([canonicalized-location (canonicalize-path location)])
      (location-inside? canonicalized-location
                        static-assets-dir-location))))


(define safe/static-asset-location?
  (λ (path)
    "A combination of safe-location? and static-asset-location?."
    (and (static-asset-location? path)
         (safe-location? path static-assets-dir-location))))


(define static-asset-location
  (λ (location-parts)
    (apply fslib:fsing-join
           (cons static-assets-dir-name
                 location-parts))))
